Ultra Pack/UltraComputing Partner Applications.iso/SunLabs/tclTK/src/tcl7.4/tests/open.test

Text File | 1995-02-21 | 19.8 KB | 630 lines

# Commands covered:  open, close, gets, puts, read, seek, tell, eof, flush
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) open.test 1.27 95/02/20 16:35:10

if {[string compare test [info procs test]] == 1} then {source defs}

catch {exec rm -f test1 test2 test3}
exec cat > test1 << "Two lines: this one\nand this one\n"
exec cat > test2 << "line1\nline2\nline3\nline4\nline5\n"

test open-1.1 {open command (files only)} {
    set f [open test1]
    set x [gets $f]
    close $f
    set x
} {Two lines: this one}
test open-1.2 {open command (files only)} {
    set f [open test1]
    set f2 [open test2]
    set f3 [open test1]
    set f4 [open test1]
    set x [list [gets $f] [gets $f2] [gets $f3] [gets $f4] \
        [gets $f] [gets $f2]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{Two lines: this one} line1 {Two lines: this one} {Two lines: this one} {and this one} line2}
test open-1.3 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz
    close $f
    exec cat test3
} "xyz"
test open-1.4 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz
    close $f
    set f [open test3 a]
    puts $f 123
    close $f
    exec cat test3
} "xyz\n123"
test open-1.5 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 r+]
    set x [gets $f]
    seek $f 0 current
    puts $f 456
    close $f
    list $x [exec cat test3]
} "xyz {xyz
456}"
test open-1.6 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 w+]
    puts $f xyzzy
    seek $f 2
    set x [gets $f]
    close $f
    list $x [exec cat test3]
} "zzy xyzzy"
test open-1.7 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 a+]
    puts $f xyzzy
    flush $f
    set x [tell $f]
    seek $f -4 cur
    set y [gets $f]
    close $f
    list $x [exec cat test3] $y
} {14 {xyz
123
xyzzy} zzy}

test open-2.1 {errors in open command} {
    list [catch {open} msg] $msg
} {1 {wrong # args: should be "open filename ?access? ?permissions?"}}
test open-2.2 {errors in open command} {
    list [catch {open a b c d} msg] $msg
} {1 {wrong # args: should be "open filename ?access? ?permissions?"}}
test open-2.3 {errors in open command} {
    list [catch {open test1 x} msg] $msg
} {1 {illegal access mode "x"}}
test open-2.4 {errors in open command} {
    list [catch {open test1 rw} msg] $msg
} {1 {illegal access mode "rw"}}
test open-2.5 {errors in open command} {
    list [catch {open test1 r+1} msg] $msg
} {1 {illegal access mode "r+1"}}
test open-2.6 {errors in open command} {
    string tolower [list [catch {open _non_existent_} msg] $msg $errorCode]
} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}

if {![file exists ~/_test_] && [file writable ~]} {
    test open-3.1 {tilde substitution in open} {
    set f [open ~/_test_ w]
    puts $f "Some text"
    close $f
    set x [file exists $env(HOME)/_test_]
    exec rm -f $env(HOME)/_test_
    set x
    } 1
}
test open-3.2 {tilde substitution in open} {
    set home $env(HOME)
    unset env(HOME)
    set x [list [catch {open ~/foo} msg] $msg]
    set env(HOME) $home
    set x
} {1 {couldn't find HOME environment variable to expand "~/foo"}}

test open-4.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $errorCode
} {1 {bad file identifier "gorp"} NONE}
test open-4.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {bad file identifier "filex"}}
test open-4.3 {file id parsing errors} {
    list [catch {eof file12a} msg] $msg
} {1 {bad file identifier "file12a"}}
test open-4.4 {file id parsing errors} {
    list [catch {eof file123} msg] $msg
} {1 {file "file123" isn't open}}
test open-4.5 {file id parsing errors} {
    list [catch {eof file1} msg] $msg
} {0 0}
test open-4.6 {file id parsing errors} {
    list [catch {eof stdin} msg] $msg
} {0 0}
test open-4.7 {file id parsing errors} {
    list [catch {eof stdout} msg] $msg
} {0 0}
test open-4.8 {file id parsing errors} {
    list [catch {eof stderr} msg] $msg
} {0 0}
test open-4.9 {file id parsing errors} {
    list [catch {eof stderr1} msg] $msg
} {1 {bad file identifier "stderr1"}}
set f [open test1]
close $f
set expect "1 {file \"$f\" isn't open}"
test open-4.10 {file id parsing errors} {
    list [catch {eof $f} msg] $msg
} $expect

test open-5.1 {close command (files only)} {
    list [catch {close} msg] $msg $errorCode
} {1 {wrong # args: should be "close fileId"} NONE}
test open-5.2 {close command (files only)} {
    list [catch {close a b} msg] $msg $errorCode
} {1 {wrong # args: should be "close fileId"} NONE}
test open-5.3 {close command (files only)} {
    list [catch {close gorp} msg] $msg $errorCode
} {1 {bad file identifier "gorp"} NONE}
test open-5.4 {close command (files only)} {
    list [catch {close file4} msg] \
        [string range $msg [string first {" } $msg] end] $errorCode
} {1 {" isn't open} NONE}

test open-6.1 {puts command} {
    list [catch {puts} msg] $msg $errorCode
} {1 {wrong # args: should be "puts ?-nonewline? ?fileId? string"} NONE}
test open-6.2 {puts command} {
    list [catch {puts a b c d} msg] $msg $errorCode
} {1 {wrong # args: should be "puts ?-nonewline? ?fileId? string"} NONE}
test open-6.3 {puts command} {
    list [catch {puts a b nonewlinx} msg] $msg $errorCode
} {1 {bad argument "nonewlinx": should be "nonewline"} NONE}
test open-6.4 {puts command} {
    list [catch {puts gorp "New text"} msg] $msg $errorCode
} {1 {bad file identifier "gorp"} NONE}
test open-6.5 {puts command} {
    set f [open test3]
    set x [list [catch {puts $f "New text"} msg] \
    [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for writing} NONE}
test open-6.6 {puts command} {
    set f [open test3 w]
    puts -nonewline $f "Text1"
    puts -nonewline $f " Text 2"
    puts $f " Text 3"
    close $f
    exec cat test3
} {Text1 Text 2 Text 3}

test open-7.1 {gets command} {
    list [catch {gets} msg] $msg $errorCode
} {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
test open-7.2 {gets command} {
    list [catch {gets a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
test open-7.3 {gets command} {
    list [catch {gets a} msg] $msg $errorCode
} {1 {bad file identifier "a"} NONE}
test open-7.4 {gets command} {
    set f [open test3 w]
    set x [list [catch {gets $f} msg] \
        [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for reading} NONE}
set f [open test3 w]
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
test open-7.5 {gets command with long line} {
    set f [open test3]
    set x [gets $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test open-7.6 {gets command with long line} {
    set f [open test3]
    set x [gets $f y]
    close $f
    list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test open-7.7 {gets command and end of file} {
    set f [open test3 w]
    puts -nonewline $f "Test1\nTest2"
    close $f
    set f [open test3]
    set x {}
    set y {}
    lappend x [gets $f y] $y
    set y {}
    lappend x [gets $f y] $y
    set y {}
    lappend x [gets $f y] $y
    close $f
    set x
} {5 Test1 5 Test2 -1 {}}
set f [open test3 w]
puts $f "Line 1"
puts $f "Line 2"
close $f
test open-7.8 {gets command and bad variable} {
    catch {unset x}
    set x 24
    set f [open test3 r]
    set result [list [catch {gets $f x(0)} msg] $msg]
    close $f
    set result
} {1 {can't set "x(0)": variable isn't array}}

test open-8.1 {read command} {
    list [catch {read} msg] $msg $errorCode
} {1 {wrong # args: should be "read fileId ?numBytes?" or "read ?-nonewline? fileId"} NONE}
test open-8.2 {read command} {
    list [catch {read -nonewline} msg] $msg $errorCode
} {1 {bad file identifier "-nonewline"} NONE}
test open-8.3 {read command} {
    list [catch {read a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "read fileId ?numBytes?" or "read ?-nonewline? fileId"} NONE}
test open-8.4 {read command} {
    list [catch {read -nonew file4} msg] $msg $errorCode
} {1 {bad file identifier "-nonew"} NONE}
test open-8.5 {read command} {
    list [catch {read stdin foo} msg] $msg $errorCode
} {1 {bad argument "foo": should be "nonewline"} NONE}
test open-8.6 {read command} {
    list [catch {read file10} msg] $msg $errorCode
} {1 {file "file10" isn't open} NONE}
test open-8.7 {read command} {
    set f [open test3 w]
    set x [list [catch {read $f} msg] \
        [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for reading} NONE}
test open-8.8 {read command} {
    set f [open test1]
    set x [list [catch {read $f 12z} msg] $msg $errorCode]
    close $f
    set x
} {1 {expected integer but got "12z"} NONE}
test open-8.9 {read command} {
    set f [open test1]
    set x [list [catch {read $f z} msg] $msg $errorCode]
    close $f
    set x
} {1 {bad argument "z": should be "nonewline"} NONE}
test open-8.10 {read command} {
    set f [open test1]
    set x [list [read $f 1] [read $f 2] [read $f]]
    close $f
    set x
} {T wo { lines: this one
and this one
}}
test open-8.11 {read command, with over-large count} {
    set f [open test1]
    set x [read $f 100]
    close $f
    set x
} {Two lines: this one
and this one
}
test open-8.12 {read command, -nonewline switch} {
    set f [open test1]
    set x [read -nonewline $f]
    close $f
    set x
} {Two lines: this one
and this one}

test open-9.1 {seek command} {
    list [catch {seek foo} msg] $msg $errorCode
} {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
test open-9.2 {seek command} {
    list [catch {seek foo a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
test open-9.3 {seek command} {
    list [catch {seek foo 0} msg] $msg $errorCode
} {1 {bad file identifier "foo"} NONE}
test open-9.4 {seek command} {
    set f [open test2]
    set x [list [catch {seek $f xyz} msg] $msg $errorCode]
    close $f
    set x
} {1 {expected integer but got "xyz"} NONE}
test open-9.5 {seek command} {
    set f [open test2]
    set x [list [catch {seek $f 100 gorp} msg] $msg $errorCode]
    close $f
    set x
} {1 {bad origin "gorp": should be start, current, or end} NONE}
set f [open test3 w]
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
test open-9.6 {seek command} {
    set f [open test3]
    set x [read $f 1]
    seek $f 3
    lappend x [read $f 1]
    seek $f 0 start
    lappend x [read $f 1]
    seek $f 10 current
    lappend x [read $f 1]
    seek $f -2 end
    lappend x [read $f 1]
    seek $f 50 end
    lappend x [read $f 1]
    seek $f 1
    lappend x [read $f 1]
    close $f
    set x
} {a d a l Y {} b}

test open-10.1 {tell command} {
    list [catch {tell} msg] $msg $errorCode
} {1 {wrong # args: should be "tell fileId"} NONE}
test open-10.2 {tell command} {
    list [catch {tell a b} msg] $msg $errorCode
} {1 {wrong # args: should be "tell fileId"} NONE}
test open-10.3 {tell command} {
    list [catch {tell a} msg] $msg $errorCode
} {1 {bad file identifier "a"} NONE}
test open-10.4 {tell command} {
    set f [open test2]
    set x [tell $f]
    read $f 3
    lappend x [tell $f]
    seek $f 2
    lappend x [tell $f]
    seek $f 10 current
    lappend x [tell $f]
    seek $f 0 end
    lappend x [tell $f]
    close $f
    set x
} {0 3 2 12 30}

test open-11.1 {eof command} {
    list [catch {eof} msg] $msg $errorCode
} {1 {wrong # args: should be "eof fileId"} NONE}
test open-11.2 {eof command} {
    list [catch {eof a b} msg] $msg $errorCode
} {1 {wrong # args: should be "eof fileId"} NONE}
test open-11.3 {eof command} {
    list [catch {eof file100} msg] $msg $errorCode
} {1 {file "file100" isn't open} NONE}
test open-11.4 {eof command} {
    set f [open test1]
    set x [eof $f]
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    lappend x [eof $f]
    close $f
    set x
} {0 0 0 0 1 1}

test open-12.1 {flush command} {
    list [catch {flush} msg] $msg $errorCode
} {1 {wrong # args: should be "flush fileId"} NONE}
test open-12.2 {flush command} {
    list [catch {flush a b} msg] $msg $errorCode
} {1 {wrong # args: should be "flush fileId"} NONE}
test open-12.3 {flush command} {
    list [catch {flush a} msg] $msg $errorCode
} {1 {bad file identifier "a"} NONE}
test open-12.4 {flush command} {
    set f [open test3]
    set x [list [catch {flush $f} msg] \
        [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for writing} NONE}
test open-12.5 {flush command} {
    set f [open test3 w]
    puts $f "Line 1"
    puts $f "Line 2"
    set f2 [open test3]
    set x {}
    lappend x [read -nonewline $f2]
    close $f2
    flush $f
    set f2 [open test3]
    lappend x [read -nonewline $f2]
    close $f2
    close $f
    set x
} {{} {Line 1
Line 2}}

test open-13.1 {I/O to command pipelines} {
    list [catch {open "| cat < test1 > test3" w} msg] $msg $errorCode
} {1 {can't write input to command: standard input was redirected} NONE}
test open-13.2 {I/O to command pipelines} {
    list [catch {open "| echo > test3" r} msg] $msg $errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test open-13.3 {I/O to command pipelines} {
    list [catch {open "| echo > test3" r+} msg] $msg $errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test open-13.4 {writing to command pipelines} {
    exec rm test3
    set f [open "| cat | cat > test3" w]
    puts $f "Line 1"
    puts $f "Line 2"
    close $f
    exec cat test3
} {Line 1
Line 2}
test open-13.5 {reading from command pipelines} {
    set f [open "| cat test2" r]
    set x [list [gets $f] [gets $f] [gets $f]]
    close $f
    set x
} {line1 line2 line3}
test open-13.6 {both reading and writing from/to command pipelines} {
    set f [open "| cat -u" r+]
    puts $f "Line1"
    flush $f
    set x [gets $f]
    close $f
    set x
} {Line1}
test open-13.7 {errors in command pipelines} {
    list [catch {open "|gorp"} msg] [string tolower $msg] \
        [string tolower $errorCode]
} {1 {couldn't execute "gorp": no such file or directory} {posix enoent {no such file or directory}}}
test open-13.8 {errors in command pipelines} {
    set f [open "|sleep 1" w]
    exec sleep 3
    puts $f output
    set x [list [catch {flush $f} msg] [concat \
        [string range $msg 0 [string first {"} $msg]] \
        [string range $msg [string first : $msg] end]] $errorCode]
    catch {close $f}
    string tolower $x
} {1 {error flushing " : broken pipe} {posix epipe {broken pipe}}}

test open-14.1 {POSIX open access modes: RDONLY} {
    set f [open test1 RDONLY]
    set x [list [gets $f] [catch {puts $f Test} msg] $msg]
    close $f

    # The regsub is needed to avoid false errors if the file
    # number varies from system to system.

    regsub {"file[0-9]*"} $x {"file"} x
    set x
} {{Two lines: this one} 1 {"file" wasn't opened for writing}}
test open-14.2 {POSIX open access modes: RDONLY} {
    catch {exec rm -f test3}
    string tolower [list [catch {open test3 RDONLY} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
test open-14.3 {POSIX open access modes: WRONLY} {
    catch {exec rm -f test3}
    string tolower [list [catch {open test3 WRONLY} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
test open-14.4 {POSIX open access modes: WRONLY} {
    exec echo xyzzy > test3
    set f [open test3 WRONLY]
    puts -nonewline $f "ab"
    seek $f 0 current
    set x [list [catch {gets $f} msg] $msg]
    close $f
    lappend x [exec cat test3]

    # The regsub is needed to avoid false errors if the file
    # number varies from system to system.

    regsub {"file[0-9]*"} $x {"file"} x
    set x
} {1 {"file" wasn't opened for reading} abzzy}
test open-14.5 {POSIX open access modes: RDWR} {
    catch {exec rm -f test3}
    string tolower [list [catch {open test3 RDWR} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
test open-14.6 {POSIX open access modes: RDWR} {
    exec echo xyzzy > test3
    set f [open test3 RDWR]
    puts -nonewline $f "ab"
    seek $f 0 current
    set x [gets $f]
    close $f
    lappend x [exec cat test3]
} {zzy abzzy}
test open-14.7 {POSIX open access modes: CREAT} {
    catch {exec rm -f test3}
    set f [open test3 {WRONLY CREAT} 0600]
    file stat test3 stats
    set x [format "0%o" [expr $stats(mode)&0777]]
    puts $f "line 1"
    close $f
    lappend x [exec cat test3]
} {0600 {line 1}}
if $doNonPortableTests {
    test open-14.8 {POSIX open access modes: CREAT} {
    catch {exec rm -f test3}
    set f [open test3 {WRONLY CREAT}]
    close $f
    file stat test3 stats
    format "0%o" [expr $stats(mode)&0777]
    } 0664
}
test open-14.9 {POSIX open access modes: CREAT} {
    exec echo xyzzy > test3
    set f [open test3 {WRONLY CREAT}]
    puts -nonewline $f "ab"
    close $f
    exec cat test3
} abzzy
test open-14.10 {POSIX open access modes: APPEND} {
    exec echo xyzzy > test3
    set f [open test3 {WRONLY APPEND}]
    puts $f "new line"
    seek $f 0
    puts $f "abc"
    close $f
    exec cat test3
} {xyzzy
new line
abc}
test open-14.11 {POSIX open access modes: EXCL} {
    exec echo xyzzy > test3
    set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg]
    regsub " already " $msg " " msg
    string tolower $msg
} {1 {couldn't open "test3": file exists}}
test open-14.12 {POSIX open access modes: EXCL} {
    catch {exec rm -f test3}
    set x [catch {set f [open test3 {WRONLY CREAT EXCL}]}]
    puts $f "A test line"
    close $f
    lappend x [exec cat test3]
} {0 {A test line}}
test open-14.13 {POSIX open access modes: TRUNC} {
    exec echo xyzzy > test3
    set f [open test3 {WRONLY TRUNC}]
    puts $f abc
    close $f
    exec cat test3
} {abc}
if $doNonPortableTests {
    test open-14.14 {POSIX open access modes: NONBLOCK} {
    catch {exec rm -f test3}
    set f [open test3 {WRONLY NONBLOCK CREAT}]
    puts $f "NONBLOCK test"
    close $f
    exec cat test3
    } {NONBLOCK test}
}
test open-14.15 {POSIX open access modes: errors} {
    concat [catch {open test3 "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
} "1 unmatched open brace in list
unmatched open brace in list
    while processing open access modes \"FOO {BAR BAZ\"
    invoked from within
\"open test3 \"FOO \\{BAR BAZ\"\""
test open-14.16 {POSIX open access modes: errors} {
    list [catch {open test3 {FOO BAR BAZ}} msg] $msg
} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}}
test open-14.17 {POSIX open access modes: errors} {
    list [catch {open test3 {TRUNC CREAT}} msg] $msg
} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}

catch {exec rm -f test1 test2 test3}
concat {}